'''''''''''''''''''''''''''''''''''''''''''''''''
' Enventory
'
' vbscript toolset to support administration, Enventory and control of AD Users and PC assets
'
' Copyright (C) ' by ufe@gmx.de
' started  July/August 2008, 
' based on work done within ::
'''''''''''''''''''''''''''''''''''
' Open Audit                  '
' http://open-audit.org	      '
' Software and Hardware Enventory '
' Outputs into MySQL          '
' (c) Mark Unwin 2003         '
'''''''''''''''''''''''''''''''''''
'
' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License along
' with this program; if not, write to the Free Software Foundation, Inc.,
' 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
'
Option Explicit
'  64bit workaround
'
' this script code relies on 32bit COM objects, if we are running on
' a 64bit system we will want to run under WOW64 (the x86 emulator).

'http://blogs.msdn.com/b/joshpoley/archive/2008/09/18/running-32bit-dependent-scripts-in-a-64bit-world.aspx

dim myHostShell

public function IS64()
	On Error Resume Next
	
	Dim WshShell
	Dim OsType

	Set WshShell = CreateObject("WScript.Shell")

	OsType = WshShell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\PROCESSOR_ARCHITECTURE")

	If OsType = "x86" then
		'wscript.excho "Windows 32bit system detected"
		IS64 = false
	elseif OsType = "AMD64" then
		'wscript.echo "Windows 64bit system detected"
		IS64 = true
	end if
end function

public function ISshell64()
	'On Error Resume Next
	
	Dim host
	host = WScript.FullName
	host = lcase(host)
	'wscript.echo "ISshell64 host:" & host
	if is64() then
	'	wscript.echo "is 64"
	'	wscript.echo InStr(1, host, "system32", vbTextCompare)
		if InStr(1, host, "system32", vbTextCompare) <> 0 then
	'		wscript.echo "64 bit - 64bit shell detected"
			ISshell64 = true
		else
	'	wscript.echo InStr(1, host, "syswow64", vbTextCompare) 
		if  InStr(1, host, "syswow64", vbTextCompare) <> 0 then 
	'			wscript.echo "64 bit - 32bit shell detected"
				ISshell64 = false
			end if
		end if
	else
	   ISshell64 = false
	end if
end function

public function WinDirGet()
	dim shell
	set shell = WScript.CreateObject("WScript.Shell")
	WinDirGet = shell.ExpandEnvironmentStrings("%windir%")
end function

public function ParameterGet()
	dim strArg
	Dim ArgObj
	Set ArgObj = WScript.Arguments
	'wScript.Echo WScript.Arguments.Count
	ParameterGet = ""
	For Each strArg in ArgObj
		ParameterGet = ParameterGet & " " & strArg
    next
end function  
	

' check to see if we are on an AMD64 processor and running the
' wrong version of the scripting host.

if IS64() then
	myHostShell = "64"
else
	myHostShell =  "32"
end if

if ISshell64() then
	myHostShell = myHostShell & "/shell64"
else
	myHostShell = myHostShell & "/shell32"
end if 
 
 
if ISshell64() then
    dim newcmd
	newcmd = windirget()&"\SysWoW64\cscript.exe " & WScript.ScriptFullName & ParameterGet()
	dim shell
	dim exec
	dim ret
	set shell = WScript.CreateObject("WScript.Shell")
   'WScript.Echo(myHostShell & " start")
	'wscript.echo newcmd
    ret = Shell.Run (newcmd, 0, true)
	'WScript.Echo(myHostShell & " end")
	
    WScript.Quit(ret)
 end if
 
' the real script code goes here ...

'wscript.Echo(myHostShell & " go")

Public SuiteName : SuiteName = "E-nventory"
Public  SuiteProg : SuiteProg = "ADLists"

Dim XMLfileObj

Dim EnventoryLogDir
Dim EnventoryDataDir
Dim EmailFrom
Dim EmailTo
Dim DDEEVV
Dim DBhistoryDays
Dim DBhistoryUnique
Dim DBTablePerComputer
Dim DBTablePerOU
Dim DBTableVersion : DBTableVersion = "0.6"
Dim RUNFrequence

Dim WSHFileSignature

Dim EmailCc
Dim EmailServer
Dim EMailPort

Dim MyTypeMemo 
Dim MyTypeAutoincrement
Dim MyTablePrefix
Dim MyViewStatement
Dim MyAutoIndex
Dim MyAutoIndexGet


Dim  NtpServer

Const PwdLastSetGetPwdLastSet = 0
Const PwdLastSetGetMaxPwdAge = 1
Const PwdLastSetGetCanExpire = 2
Const PwdLastSetGetIsExpired = 3

'' Below calls the config and tool files to setups.
on error resume next
Dim sScriptPath
sScriptPath = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\"))
ExecuteGlobal CreateObject("Scripting.FileSystemObject").OpenTextFile(sScriptPath & SuiteName & ".tools.vbs").ReadAll
If Err.Number <> 0 Then
			wscript.echo WScript.ScriptFullName & "::" & myScriptPath & SuiteName & ".tools.vbs " & Err.Number & " -- " &  Err.Description
			Err.Clear
End If
ExecuteGlobal CreateObject("Scripting.FileSystemObject").OpenTextFile(sScriptPath & SuiteName & ".tools-XML.vbs").ReadAll
If Err.Number <> 0 Then
			wscript.echo WScript.ScriptFullName & "::" & myScriptPath & SuiteName & ".tools.vbs " & Err.Number & " -- " &  Err.Description
			Err.Clear
End If
Dim myScriptNameExExt
Dim myScriptNameExExtExt
myScriptNameExExt=Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,".") -1)
myScriptNameExExtExt=Left(myScriptNameExExt,InStrRev(myScriptNameExExt,".")-1)
'wscript.echo WScript.ScriptFullName & "::" & ("myScriptNameExExtExt " & myScriptNameExExtExt & ".conf.vbs")
'wscript.echo WScript.ScriptFullName & "::" & ("myScriptNameExExt " & myScriptNameExExt & ".conf.vbs")

ExecuteGlobal CreateObject("Scripting.FileSystemObject").OpenTextFile(myScriptNameExExtExt & ".conf.vbs").ReadAll
If Err.Number <> 0 Then
			wscript.echo WScript.ScriptFullName & "::" & myScriptNameExExtExt & ".conf.vbs " & Err.Number & " -- " &  Err.Description
			Err.Clear
End If
ExecuteGlobal CreateObject("Scripting.FileSystemObject").OpenTextFile(myScriptNameExExt & ".conf.vbs").ReadAll
If Err.Number <> 0 Then
			wscript.echo WScript.ScriptFullName & "::" &  myScriptNameExExt & ".conf.vbs " & Err.Number & " -- " &  Err.Description
			Err.Clear
End If 

Call Main()

Public Sub Main()
	if DDEEVV = true then On Error Goto 0 Else On Error Resume Next
	dim htmlbody
	Call ToolsTimerStart()
	Dbopen()
	myDebug("DB opened")
	'wscript.echo ("dbopened")
	
	If LDAPCheck () = False Then
		LogfileWrite("Not connected to Domain, quiting ...")	
		myDebug("Not connected to Domain, quiting ..." )
		Call logfileclose()
		WScript.quit()
	End If
	
	'If DBCheckRunFrequency("LastRun",ComputerNameGet()) Then 
	If DBCheckRunFrequency(DBGetTableName("LastRun"), "", "") Then 
		myDebug("update needed, " & RUNFrequence & " execced" )			
		htmlbody = SuiteName &"."&SuiteProg & " " & UserNameGet() & "@" & ComputerNameGet() & "- started!"
		Call SendMail (SuiteName &"."&SuiteProg & " " & UserNameGet() & "@" & ComputerNameGet() & "- started!" , htmlBody, "")
		dim TableData(20,2)
		dim TableWhere(20,2)
		Dim TableI : TableI = 0
		TableData (TableI,0) = "LastRunDate" 	: TableData (TableI,1) = "date" 	: TableData (TableI,2) = DBSqlDateGet(date)		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "" 				: TableData (TableI,1) = "" 		: TableData (TableI,2) = ""
		'TableWhere (0,0) = "[ecomputer]"				: TableWhere (0,1) =  MyTypeMemo  	: TableWhere (0,2) = ComputerNameGet()
		TableWhere (0,0) = "" 					: TableWhere (0,1) = "" 			: TableWhere (0,2) = ""

		set XMLfileObj =  XMLInit(computernameGet() )
		
		myDebug("<h1>UserListCreate</h1>" )			
		Call UserListCreate
		
		myDebug("<h1>ComputerListCreate</h1>" )			
		Call ComputerListCreate
		
		myDebug("<h1>UserAccessoireListCreate</h1>" )			
		call UserAccessoireListCreate
		
		myDebug("<h1>GroupListCreate</h1>" )			
		call GroupListCreate
		
		'takes a long long time to run
		myDebug("<h1>GroupUserListCreate</h1>" )			
		call GroupUserListCreate 
		
		myDebug("<h1>Export</h1>" )			
		XMLWrite XMLfileObj, "ALL"
		DBDOTableAr DBGetTableName("LastRun"), DBTableVersion, TableData, TableWhere, DBhistoryUnique ' because it takes so long!
		EventLogWrite EVENT_SUCCESS, WScript.ScriptFullName & " Execution Time: " & ToolsTimerGet()  & " seconds."
	else 
		myDebug("no update needed, " & RUNFrequence & " not execced" )
'		LogFileWrite("no update needed, " & RUNFrequence & " not execced" )
	End If	
	
	'call ViewCreate()
	Call SendMail (SuiteName &"."&SuiteProg & " " & UserNameGet() & "@" & ComputerNameGet() & "- finished!" , htmlBody, "")
	logfileclose()
	
End Sub


Public Sub UserListCreate
	dim MessageToSend
	Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
	Dim objUser

	Dim objRootDSE, strDNSDomain, strQuery, adoRecordset
	Dim PwdArr 
	Dim debugCount
	debugCount = 0

' Setup ADO objects.
	Set adoCommand = CreateObject("ADODB.Command")
	Set adoConnection = CreateObject("ADODB.Connection")
	adoConnection.Provider = "ADsDSOObject"
	adoConnection.Open "Active Directory Provider"
	adoCommand.ActiveConnection = adoConnection

'	dim CNToCheck
'	CNTOCheck = CNTOCheck = "OU=DE,DC=myDom,DC=myTLD"  ' which users should be considered
'	CNTOCheck = "OU=DE," ' which users should be considered

' 	Search entire Active Directory domain.

	Set objRootDSE = GetObject("LDAP://RootDSE")

	strDNSDomain = objRootDSE.Get("defaultNamingContext")
	if cntoCheck <> "" then
		strBase = "<LDAP://" & cntoCheck & ">"
	else
		strBase = "<LDAP://" & strDNSDomain  & ">"
	end if
	
	myDebug("searchbase: " &  strbase )
	if DDEEVV = true then  LogFileWrite("searchbase: " &  strbase )
	
	' Filter on user objects.
	strFilter = "(&(objectCategory=person)(objectClass=user))"
	'strFilter = "(&(objectCategory=person)(objectClass=user)(!sAMAccountType=805306370)(!manager=*))" 
 	' Comma delimited list of attribute values to retrieve.
	strAttributes = "sAMAccountName,distinguishedName"

	' Construct the LDAP syntax query.
	strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	adoCommand.CommandText = strQuery
	adoCommand.Properties("Page Size") = 100
	adoCommand.Properties("Timeout") = 30
	adoCommand.Properties("Cache Results") = False

	' Run the query.
	Set adoRecordset = adoCommand.Execute

	dim strsAMAccountName, strDistinguishedName
	' Enumerate the resulting recordset.
	
	dim TableData(150,2)
	dim TableWhere(40,2)
	dim TableI 
	
	Do Until adoRecordset.EOF

		'if DDEEVV = true then On Error Goto 0 Else On Error Resume Next
		On Error Resume Next
	    ' Retrieve values and display.
	    strsAMAccountName = adoRecordset.Fields("sAMAccountName").Value
	    strdistinguishedName = adoRecordset.Fields("distinguishedName").value

		Set objUser = ADOpen(strDistinguishedName)
		if not isobject(objUser)  then
				myDebug("strDistinguishedName: no object " & strDistinguishedName )
				if DDEEVV = true then  LogFileWrite("strDistinguishedName: no object " & strDistinguishedName )	
				'continue 
		end if 
		
		myDebug("strDistinguishedName: " & strDistinguishedName )
		if DDEEVV = true then  LogFileWrite("strDistinguishedName: " & strDistinguishedName )
		TableI = 0
		
		'TableData (TableI,0) = "[ID]" 					: TableData (TableI,1) = "Autoincrement(1,1)" 	: TableData (TableI,2) = "*"							: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'on error resume next
		'.distinguishedName
		TableData (TableI,0) = "[DistinguishedName]" 	: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(strDistinguishedName) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 		
		'.sAMAccountName
		TableData (TableI,0) = "[sAMAccountName]" 		: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(StrsAMAccountName) 			: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.displayName, ".displayName", introw)
		TableData (TableI,0) = "[displayname]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.displayname) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
	
		'.sn, 
		TableData (TableI,0) = "[sn]" 					: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.sn) 					: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.givenName, 
		TableData (TableI,0) = "[givenName]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.givenName) 			: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.st, 
		TableData (TableI,0) = "[st]" 					: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.st) 				: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.streetAddress,
		TableData (TableI,0) = "[streetAddress]" 		: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.streetAddress) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.physicalDeliveryOfficeName, 
		TableData (TableI,0) = "[physicalDeliveryOfficeName]" 		: TableData (TableI,1) = MyTypeMemo 	: TableData (TableI,2) = clean(objuser.physicalDeliveryOfficeName) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.postalCode, 
		TableData (TableI,0) = "[postalCode]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.postalCode) 			: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.l, 
		TableData (TableI,0) = "[l]" 					: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.l) 					: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.mail,
		TableData (TableI,0) = "[mail]" 				: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.mail) 				: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.company, 
		TableData (TableI,0) = "[company]" 				: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.company) 			: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.Department,
		TableData (TableI,0) = "[Department]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.Department) 			: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.title, 
		TableData (TableI,0) = "[title]" 				: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.title) 				: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.mobile,
		TableData (TableI,0) = "[mobile]" 				: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.mobile) 				: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.telephoneNumber, 
		TableData (TableI,0) = "[telephoneNumber]" 		: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.telephoneNumber) 	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.telephoneAssistant, 
		TableData (TableI,0) = "[telephoneAssistant]" 	: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.telephoneAssistant) 	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.facsimileTelephoneNumber, 
		TableData (TableI,0) = "[facsimileTelephoneNumber]" 		: TableData (TableI,1) = MyTypeMemo 	: TableData (TableI,2) = clean(objuser.facsimileTelephoneNumber) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.pager, 
		TableData (TableI,0) = "[pager]" 				: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.pager) 				: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.otherTelephone, 
		TableData (TableI,0) = "[otherTelephone]" 		: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.otherTelephone) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.homePhone, 
		TableData (TableI,0) = "[homePhone]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.homePhone) 			: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.whenChanged,
		TableData (TableI,0) = "[whenChanged]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.whenChanged) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.whenCreated, 
		TableData (TableI,0) = "[whenCreated]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.whenCreated) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.initials, 
		TableData (TableI,0) = "[initials]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.initials) 			: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.manager, 
		TableData (TableI,0) = "[manager]" 				: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(ManagerGet(strdistinguishedName)) : myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.extensionAttribute15, "extensionAttribute15",
		TableData (TableI,0) = "[extensionAttribute15]" 		: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.extensionAttribute15): myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.extensionAttribute3, "extensionAttribute3",
		TableData (TableI,0) = "[extensionAttribute3]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.extensionAttribute3) : myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'AccountDisabled
		mydebug ("Before disabled")
		If objuser.AccountDisabled = True Then
			TableData (TableI,0) = "[Accountstatus]" 	: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = "DISABLED"							: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		Else
			TableData (TableI,0) = "[Accountstatus]" 	: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = "enabled"							: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 	
		End If
		
		PwdArr =PwdLastSetGet(strdistinguishedName)
		TableData (TableI,0) = "[PwdLastSet]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(PwdArr (PwdLastSetGetPwdLastSet)) 	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "[MaxPwdAge]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(PwdArr (PwdLastSetGetMaxPwdAge)) 	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "[CanExpire]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(PwdArr (PwdLastSetGetCanExpire)) 	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "[IsExpired]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(PwdArr (PwdLastSetGetIsExpired)) 	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		
		TableData (TableI,0) = "[ouTeam]" 				: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extractOU1(strdistinguishedName)) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "[ouCompany]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extractOU2(strdistinguishedName )) 	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		
		'logonasstring(objuser), "lastlogon"
		TableData (TableI,0) = "[lastlogon]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(logonasstring(objuser)) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "[info-h]" 				: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extract(objuser.info, "h"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "[info-k]" 				: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extract(objuser.info, "k"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'extract(objuser.info, "info-s")
		TableData (TableI,0) = "[info-s]" 				: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extract(objuser.info, "s")) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
				
		'.userPrincipalName, 
		'.directReports, 
		'.distinguishedName,
		'.sAMAccountName, 

		'.info, 
		'.extensionAttribute10,
		'.extensionAttribute11, 
		'.extensionAttribute14, 
		'.extensionAttribute2, 
		
		'.extensionAttribute4, 
		'.extensionAttribute5, 
		'.extensionAttribute6, 
		'.extensionAttribute7, 
		'.extensionAttribute8, 
		'.extensionAttribute9, 
		'.homeDirectory, 
		'.userAccountControl, 
		'.userParameters, 
		'.textEncodedORAddress, 
		'.Comment, 
		'.st, 
		'.c, 
		'.co, 
		'.DN,
		'.accountExpires, 
		'.adminCount, 
		'.altRecipient, 
		'.autoReplyMessage, 
		'.badPasswordTime,
		'.badPwdCount, 
		'.c, 
		'.cn, 
		'.co, 
		'.codePage, 
		'.Comment,
		'.countryCode, 
		'.deletedItemFlags, 
		'.delivContLength, 
		'.deliverAndRedirect, 
		'.Description, 
		'.displayName,
		'.dNSHostName, 
		'.dSCorePropagationData,
		'.extensionData, 
		'.garbageCollPeriod, 
		'.homeDrive,
		'.homeDB, 
		'.homeMTA, 
		'.info, 
		'.instanceType,
		'.isCriticalSystemObject, 
		'.lastLogoff, 
		'.lastLogon, 
		'.lastLogonTimestamp,
		'.legacyExchangeDN, 
		'.llserverinfo, 
		'.localPolicyFlags, 
		'.lockoutTime,
		'.logonCount,
		'.logonHours, 
		'.mail,
		'.mailNickname, 
		'.DBOverQuotaLimit, 
		'.DBStorageQuota, 
		'.DBUseDefaults,
		'.memberOf,
		'.msExchALObjectVersion, 
		'.msExchExpansionServerName,
		'.msExchHideFromAddressLists, 
		'.msExchHomeServerName, 
		'.msExchMailboxGuid, 
		'.msExchMailboxSecurityDescriptor, 
		'.msExchPoliciesIncluded,
		'.msExchRequireAuthToSendTo, 
		'.msExchUserAccountControl, 
		'.msNPAllowDialin,
		'.msRADIUSCallbackNumber, 
		'.msRADIUSServiceType,
		'.msRASSavedCallbackNumber, 
		'.msRTCSIP,
		'.name,
		'.objectCategory, 
		'.objectClass,
		'.objectGUID,
		'.objectSid, 
		'.OperatingSystem, 
		'.operatingSystemServicePack, 
		'.operatingSystemVersion, 
		'.primaryGroupID,
		'.profilePath, 
		'.proxyAddresses, 
		'.publicDelegates, 
		'.publicDelegatesBL, 
		'.pwdLastSet, 
		'.sAMAccountName,
		'.sAMAccountType, 
		'.scriptPath, 
		'.servicePrincipalName, 
		'.showInAddressBook,
		'.sIDHistory,
		'.submissionContLength,
		'.uSNChanged, 
		'.uSNCreated, 

		TableData (TableI,0) = "" 						: TableData (TableI,1) = "" 					: TableData (TableI,2) = ""
	
		TableI = 0
		TableWhere (TableI,0) = "[DistinguishedName]" 		: TableWhere (TableI,1) = "text (400)" 	: TableWhere (TableI,2) = clean(StrDistinguishedName) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableWhere (TableI,0) = "" 						: TableWhere (TableI,1) = "" 		: TableWhere (TableI,2) = ""

		myDebug("sleep :" & EnventoryWaitPerRecord * 1000 )
		WScript.sleep EnventoryWaitPerRecord * 1000
		XMLDoTableAr ("User"), DBTableVersion, TableData, TableWhere, XMLfileObj
		DBDOTableAr DBGetTableName("User"), DBTableVersion, TableData, TableWhere, DBhistoryUnique 
	    ' Move to the next record in the recordset.
	    adoRecordset.MoveNext
		if DDEEVV = true then
			debugCount = debugCount + 1
			myDebug("movenext:" & debugCount)
			if debugcount = 50 then
			   exit do
			end if 
		end if
	Loop

	' Clean up.

	adoRecordset.Close
	adoConnection.Close

	DBClearHistory DBGetTableName("User") , True
	
	if MessageToSend = true then
		Call SendMail (SuiteName &"."&SuiteProg & " " & UserNameGet() & "@" & ComputerNameGet() & "- New Users found!" , htmlBody, "")
	end if
	On Error Goto 0
End Sub

Public Sub ComputerListCreate
	dim MessageToSend
	Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
	Dim objUser

	Dim objRootDSE, strDNSDomain, strQuery, adoRecordset
	Dim PwdArr 
	Dim debugCount
	debugCount = 0

' Setup ADO objects.
	Set adoCommand = CreateObject("ADODB.Command")
	Set adoConnection = CreateObject("ADODB.Connection")
	adoConnection.Provider = "ADsDSOObject"
	adoConnection.Open "Active Directory Provider"
	adoCommand.ActiveConnection = adoConnection

'	dim CNToCheck
'	CNTOCheck = CNTOCheck = "OU=DE,DC=myDom,DC=myTLD"  ' which users should be considered
'	CNTOCheck = "OU=DE," ' which users should be considered

' 	Search entire Active Directory domain.

	Set objRootDSE = GetObject("LDAP://RootDSE")

	strDNSDomain = objRootDSE.Get("defaultNamingContext")
	if cntoCheck <> "" then
		strBase = "<LDAP://" & cntoCheck & ">"
	else
		strBase = "<LDAP://" & strDNSDomain  & ">"
	end if
	
	myDebug("searchbase: " &  strbase )
	if DDEEVV = true then  LogFileWrite("searchbase: " &  strbase )
	
	' Filter on user objects.
	'strFilter = "(&(objectCategory=person)(objectClass=user))"
	strFilter = "(objectClass=Computer)"
 	' Comma delimited list of attribute values to retrieve.
	strAttributes = "sAMAccountName,distinguishedName"

	' Construct the LDAP syntax query.
	strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	adoCommand.CommandText = strQuery
	adoCommand.Properties("Page Size") = 100
	adoCommand.Properties("Timeout") = 30
	adoCommand.Properties("Cache Results") = False

	' Run the query.
	Set adoRecordset = adoCommand.Execute

	dim strsAMAccountName, strDistinguishedName
	' Enumerate the resulting recordset.
	
	dim TableData(150,2)
	dim TableWhere(40,2)
	dim TableI 
	
	Do Until adoRecordset.EOF

		if DDEEVV = true then On Error Goto 0 Else On Error Resume Next
	    ' Retrieve values and display.
	    strsAMAccountName = adoRecordset.Fields("sAMAccountName").Value
	    strdistinguishedName = adoRecordset.Fields("distinguishedName").value

		Set objUser = ADOpen(strDistinguishedName)
		if not isobject(objUser)  then
				myDebug("strDistinguishedName: no object " & strDistinguishedName )
				if DDEEVV = true then  LogFileWrite("strDistinguishedName: no object " & strDistinguishedName )	
				'continue 
		end if 
		
		myDebug("strDistinguishedName: " & strDistinguishedName )
		if DDEEVV = true then  LogFileWrite("strDistinguishedName: " & strDistinguishedName )
		TableI = 0
		
		'TableData (TableI,0) = "[ID]" 					: TableData (TableI,1) = "Autoincrement(1,1)" 	: TableData (TableI,2) = "*"							: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'on error resume next
		'.distinguishedName
		TableData (TableI,0) = "[DistinguishedName]" 	: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(strDistinguishedName) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 		
		'.sAMAccountName
		TableData (TableI,0) = "[sAMAccountName]" 		: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(StrsAMAccountName) 			: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'objuser.Description, "
		TableData (TableI,0) = "[Description]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.Description) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
 		'objuser.cn, ".cn", introw)
		TableData (TableI,0) = "[cn]" 					: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.cn)					: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'objuser.whenChanged,
		TableData (TableI,0) = "[whenChanged]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.whenChanged) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'objuser.whenCreated, 
		TableData (TableI,0) = "[whenCreated]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.whenCreated) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'objuser.lastlogond, "
		TableData (TableI,0) = "[LastLogon]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(clean(logonasstring(objuser)))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'objuser.Location, 
		TableData (TableI,0) = "[Location]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.Location) 			: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'objuser.managedBy, ".managedBy", introw)
		TableData (TableI,0) = "[managedBy]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.managedBy) 			: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'objuser.OperatingSystem, ".OperatingSystem", introw)
		TableData (TableI,0) = "[OperatingSystem]" 		: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.OperatingSystem) 	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'objuser.operatingSystemVersion, ".operatingSystemVersion", introw)
		TableData (TableI,0) = "[operatingSystemVersion]" 	: TableData (TableI,1) = MyTypeMemo 			: TableData (TableI,2) = clean(objuser.operatingSystemVersion) 	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'objuser.operatingSystemServicePack, ".operatingSystemServicePack", introw)
		TableData (TableI,0) = "[operatingSystemServicePack]" 	: TableData (TableI,1) = MyTypeMemo 		: TableData (TableI,2) = clean(objuser.operatingSystemServicePack)	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		
		'objuser.memberOf, ".memberOf", introw)
		'TableData (TableI,0) = "[Location]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.Location 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'Left(objuser.objuser.cn, 1), "computertype", introw)
		TableData (TableI,0) = "[computertype]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(Left(objuser.cn, 1)) 	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 

		'AccountDisabled
		If objuser.AccountDisabled = True Then
			TableData (TableI,0) = "[Accountstatus]" 	: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = "DISABLED"							: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		Else
			TableData (TableI,0) = "[Accountstatus]" 	: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = "enabled"							: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 	
		End If
		
		PwdArr =PwdLastSetGet(strdistinguishedName)
		TableData (TableI,0) = "[PwdLastSet]" 			: TableData (TableI,1) = MyTypeMemo 		: TableData (TableI,2) = clean(PwdArr (PwdLastSetGetPwdLastSet)) 	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "[MaxPwdAge]" 			: TableData (TableI,1) = MyTypeMemo 		: TableData (TableI,2) = clean(PwdArr (PwdLastSetGetMaxPwdAge)) 	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "[CanExpire]" 			: TableData (TableI,1) = MyTypeMemo 		: TableData (TableI,2) = clean(PwdArr (PwdLastSetGetCanExpire)) 	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "[IsExpired]" 			: TableData (TableI,1) = MyTypeMemo 		: TableData (TableI,2) = clean(PwdArr (PwdLastSetGetIsExpired)) 	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		
		TableData (TableI,0) = "[ouTeam]" 				: TableData (TableI,1) = MyTypeMemo 		: TableData (TableI,2) = clean(extractOU1(strdistinguishedName)) 	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "[ouCompany]" 			: TableData (TableI,1) = MyTypeMemo 		: TableData (TableI,2) = clean(extractOU2(strdistinguishedName)) 	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "[ouType]" 				: TableData (TableI,1) = MyTypeMemo 		: TableData (TableI,2) = clean(extractOU3(strdistinguishedName)) 	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		
		TableData (TableI,0) = "" 						: TableData (TableI,1) = "" 			: TableData (TableI,2) = ""
	
		TableI = 0
		TableWhere (TableI,0) = "[DistinguishedName]" 	: TableWhere (TableI,1) = "text (400)" 	: TableWhere (TableI,2) = clean(StrDistinguishedName) 				: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableWhere (TableI,0) = "" 						: TableWhere (TableI,1) = "" 			: TableWhere (TableI,2) = ""
	
		WScript.sleep EnventoryWaitPerRecord * 1000
		XMLDoTableAr ("Computer"), DBTableVersion, TableData, TableWhere, XMLfileObj
		DBDOTableAr DBGetTableName("Computer"), DBTableVersion, TableData, TableWhere, DBhistoryUnique 
	    ' Move to the next record in the recordset.
	    adoRecordset.MoveNext
		if DDEEVV = true then
			debugCount = debugCount + 1
			myDebug("movenext:" & debugCount)
			if debugcount = 50 then
			   exit do
			end if 
		end if
	Loop

	' Clean up.

	adoRecordset.Close
	adoConnection.Close

	DBClearHistory DBGetTableName("Computer") , True
	
	if MessageToSend = true then
		Call SendMail (SuiteName &"."&SuiteProg & " " & UserNameGet() & "@" & ComputerNameGet() & "- New Software found!" , htmlBody, "")
	end if
	On Error Goto 0
End Sub

Public Sub GroupListCreate
	dim MessageToSend
	Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
	Dim objUser

	Dim objRootDSE, strDNSDomain, strQuery, adoRecordset
	Dim PwdArr 
	Dim debugCount
	debugCount = 0

' Setup ADO objects.
	Set adoCommand = CreateObject("ADODB.Command")
	Set adoConnection = CreateObject("ADODB.Connection")
	adoConnection.Provider = "ADsDSOObject"
	adoConnection.Open "Active Directory Provider"
	adoCommand.ActiveConnection = adoConnection

'	dim CNToCheck
'	CNTOCheck = CNTOCheck = "OU=DE,DC=myDom,DC=myTLD"  ' which users should be considered
'	CNTOCheck = "OU=DE," ' which users should be considered

' 	Search entire Active Directory domain.

	Set objRootDSE = GetObject("LDAP://RootDSE")

	strDNSDomain = objRootDSE.Get("defaultNamingContext")
	if cntoCheck <> "" then
		strBase = "<LDAP://" & cntoCheck & ">"
	else
		strBase = "<LDAP://" & strDNSDomain  & ">"
	end if
	
	myDebug("searchbase: " &  strbase )
	if DDEEVV = true then  LogFileWrite("searchbase: " &  strbase )
	
	' Filter on user objects.
	strFilter = "(objectClass=group)"
	'strFilter = "(&(objectCategory=person)(objectClass=user)(!sAMAccountType=805306370)(!manager=*))" 
 	' Comma delimited list of attribute values to retrieve.
	strAttributes = "sAMAccountName,distinguishedName"

	' Construct the LDAP syntax query.
	strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	adoCommand.CommandText = strQuery
	adoCommand.Properties("Page Size") = 100
	adoCommand.Properties("Timeout") = 30
	adoCommand.Properties("Cache Results") = False

	' Run the query.
	Set adoRecordset = adoCommand.Execute

	dim strsAMAccountName, strDistinguishedName
	' Enumerate the resulting recordset.
	
	dim TableData(150,2)
	dim TableWhere(40,2)
	dim TableI 
	
	Do Until adoRecordset.EOF

		if DDEEVV = true then On Error Goto 0 Else On Error Resume Next
	    ' Retrieve values and display.
	    strsAMAccountName = adoRecordset.Fields("sAMAccountName").Value
	    strdistinguishedName = adoRecordset.Fields("distinguishedName").value

		Set objUser = ADOpen(strDistinguishedName)
		if not isobject(objUser)  then
				myDebug("strDistinguishedName: no object " & strDistinguishedName )
				if DDEEVV = true then  LogFileWrite("strDistinguishedName: no object " & strDistinguishedName )	
				'continue 
		end if 
		
		myDebug("strDistinguishedName: " & strDistinguishedName )
		if DDEEVV = true then  LogFileWrite("strDistinguishedName: " & strDistinguishedName )
		TableI = 0
		
		'TableData (TableI,0) = "[ID]" 					: TableData (TableI,1) = "Autoincrement(1,1)" 	: TableData (TableI,2) = "*"							: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'on error resume next
		'.distinguishedName
		TableData (TableI,0) = "[DistinguishedName]" 	: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(strDistinguishedName) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 		
		'.sAMAccountName
		TableData (TableI,0) = "[sAMAccountName]" 		: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(StrsAMAccountName) 			: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.displayName, ".displayName", introw)
		TableData (TableI,0) = "[displayname]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.displayname) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.mail,
		TableData (TableI,0) = "[mail]" 				: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.mail) 				: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'info, ".info", introw)
		TableData (TableI,0) = "[info]" 	    		: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objuser.info)				: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'.manager, 
		TableData (TableI,0) = "[manager]" 				: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(ManagerGet(strdistinguishedName)) : myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		
		TableData (TableI,0) = "" 						: TableData (TableI,1) = "" 					: TableData (TableI,2) = ""
	
		TableI = 0
		TableWhere (TableI,0) = "[DistinguishedName]" 	: TableWhere (TableI,1) = "text (400)" 	: TableWhere (TableI,2) = clean(StrDistinguishedName) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableWhere (TableI,0) = "" 						: TableWhere (TableI,1) = "" 		: TableWhere (TableI,2) = ""
		
		WScript.sleep EnventoryWaitPerRecord * 1000
		
		XMLDoTableAr ("Groups"), DBTableVersion, TableData, TableWhere, XMLfileObj
		DBDOTableAr DBGetTableName("Groups"), DBTableVersion, TableData, TableWhere, DBhistoryUnique 
	    ' Move to the next record in the recordset.
	    adoRecordset.MoveNext
		if DDEEVV = true then
			debugCount = debugCount + 1
			myDebug("movenext:" & debugCount)
			if debugcount = 50 then
			   exit do
			end if 
		end if
	Loop

	' Clean up.

	adoRecordset.Close
	adoConnection.Close

	DBClearHistory  DBGetTableName("Groups") , True
	
	if MessageToSend = true then
		Call SendMail (SuiteName &"."&SuiteProg & " " & UserNameGet() & "@" & ComputerNameGet() & "- New Software found!" , htmlBody, "")
	end if
	On Error Goto 0
End Sub

Public Function ManagerGet(ManagerCN)
	'if DDEEVV = true then myDebug("ManagerGet(" & ManagerCN & ")")
	Dim objConnection
	Dim objCommand
	Dim objRecordSet
	
	Const ADS_SCOPE_SUBTREE = 2
	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand = CreateObject("ADODB.Command")
	objConnection.Provider = "ADsDSOObject"
	objConnection.Open "Active Directory Provider"
	
	Set objCommand.ActiveConnection = objConnection
	objCommand.CommandText = _
	"SELECT Name, displayName, Location, managedBy,distinguishedName,physicalDeliveryOfficeName " & _
	"FROM 'LDAP://" & GetDefaultNamingContext() & _
	"' WHERE objectClass='User' and directReports='" & _
	ManagerCN & _
	"'"
	
	objCommand.Properties("Page Size") = 1000
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
	Set objRecordSet = objCommand.Execute
	On Error Resume Next
	ManagerGet = ""
	objRecordSet.MoveFirst
	If Err = 0 Then
		Do Until objRecordSet.EOF
			ManagerGet = objRecordSet.Fields("displayName").Value
			'   MsgBox "Computer Name: " & objRecordSet.Fields("Name").Value & _"Location: " & objRecordSet.Fields("Location").Value
			if DDEEVV = true then LogfileWrite("Manager Name: " & objRecordSet.Fields("Name").Value & " Location: " & objRecordSet.Fields("physicalDeliveryOfficeName").Value)
			if DDEEVV = true then myDebug("Manager Name: " & objRecordSet.Fields("Name").Value & " Location: " & objRecordSet.Fields("physicalDeliveryOfficeName").Value)
			objRecordSet.MoveNext
		Loop		
	End If
	On Error Goto 0
End Function


Public Sub GroupUserListCreate
	dim MessageToSend
	Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
	Dim objUser, objgrpuser

	Dim objRootDSE, strDNSDomain, strQuery, adoRecordset
	Dim PwdArr 
	Dim debugCount
	debugCount = 0

' Setup ADO objects.
	Set adoCommand = CreateObject("ADODB.Command")
	Set adoConnection = CreateObject("ADODB.Connection")
	adoConnection.Provider = "ADsDSOObject"
	adoConnection.Open "Active Directory Provider"
	adoCommand.ActiveConnection = adoConnection

'	dim CNToCheck
'	CNTOCheck = CNTOCheck = "OU=DE,DC=myDom,DC=myTLD"  ' which users should be considered
'	CNTOCheck = "OU=DE," ' which users should be considered

' 	Search entire Active Directory domain.

	Set objRootDSE = GetObject("LDAP://RootDSE")

	strDNSDomain = objRootDSE.Get("defaultNamingContext")
	if cntoCheck <> "" then
		strBase = "<LDAP://" & cntoCheck & ">"
	else
		strBase = "<LDAP://" & strDNSDomain  & ">"
	end if
	
	myDebug("searchbase: " &  strbase )
	if DDEEVV = true then  LogFileWrite("searchbase: " &  strbase )
	
	' Filter on user objects.
	strFilter = "(objectClass=group)"
	'strFilter = "(&(objectCategory=person)(objectClass=user)(!sAMAccountType=805306370)(!manager=*))" 
 	' Comma delimited list of attribute values to retrieve.
	strAttributes = "sAMAccountName,distinguishedName"

	' Construct the LDAP syntax query.
	strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	adoCommand.CommandText = strQuery
	adoCommand.Properties("Page Size") = 100
	adoCommand.Properties("Timeout") = 30
	adoCommand.Properties("Cache Results") = False

	' Run the query.
	Set adoRecordset = adoCommand.Execute

	dim strsAMAccountName, strDistinguishedName
	' Enumerate the resulting recordset.
	
	dim TableData(150,2)
	dim TableWhere(40,2)
	dim TableI 
	
	Do Until adoRecordset.EOF

		if DDEEVV = true then On Error Goto 0 Else On Error Resume Next
	    ' Retrieve values and display.
	    strsAMAccountName = adoRecordset.Fields("sAMAccountName").Value
	    strdistinguishedName = adoRecordset.Fields("distinguishedName").value

		Set objUser = ADOpen(strDistinguishedName)
		if not isobject(objUser)  then
				myDebug("strDistinguishedName: no object " & strDistinguishedName )
				if DDEEVV = true then  LogFileWrite("strDistinguishedName: no object " & strDistinguishedName )	
				'continue 
		end if 
		
		myDebug("strDistinguishedName: " & strDistinguishedName )
		if DDEEVV = true then  LogFileWrite("strDistinguishedName: " & strDistinguishedName )
		For Each objgrpuser In objUser.Members
		
			TableI = 0
			
			'TableData (TableI,0) = "[ID]" 					: TableData (TableI,1) = "Autoincrement(1,1)" 	: TableData (TableI,2) = "*"							: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
			'on error resume next
			'.distinguishedName
			TableData (TableI,0) = "[GRDistinguishedName]" 	: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(strDistinguishedName) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 		
			'.distinguishedName
			TableData (TableI,0) = "[USdistinguishedName]" 	: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(objgrpuser.DistinguishedName) 			: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 	
			TableData (TableI,0) = "" 						: TableData (TableI,1) = "" 					: TableData (TableI,2) = ""
		
			TableI = 0
			TableWhere (TableI,0) = "[GRDistinguishedName]" 	: TableWhere (TableI,1) = "text (400)" 	: TableWhere (TableI,2) = clean(strDistinguishedName) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
			TableWhere (TableI,0) = "[USdistinguishedName]" 	: TableWhere (TableI,1) = "text (400)" 	: TableWhere (TableI,2) = clean(objgrpuser.DistinguishedName): myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
			TableWhere (TableI,0) = "" 							: TableWhere (TableI,1) = "" 			: TableWhere (TableI,2) = ""

			WScript.sleep EnventoryWaitPerRecord * 1000
			XMLDoTableAr "GroupsUsers", DBTableVersion, TableData, TableWhere, XMLfileObj
			DBDOTableAr DBGetTableName("GroupsUsers"), DBTableVersion, TableData, TableWhere, DBhistoryUnique 
		Next

	    ' Move to the next record in the recordset.
	    adoRecordset.MoveNext
		if DDEEVV = true then
			debugCount = debugCount + 1
			myDebug("movenext:" & debugCount)
			if debugcount = 50 then
			   exit do
			end if 
		end if
	Loop

	' Clean up.

	adoRecordset.Close
	adoConnection.Close

	DBClearHistory DBGetTableName("GroupsUsers") , True
	
	if MessageToSend = true then
		Call SendMail (SuiteName &"."&SuiteProg & " " & UserNameGet() & "@" & ComputerNameGet() & "- New Software found!" , htmlBody, "")
	end if
	On Error Goto 0
End Sub

Public Sub UserAccessoireListCreate
	dim MessageToSend
	Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
	Dim objUser

	Dim objRootDSE, strDNSDomain, strQuery, adoRecordset
	Dim PwdArr 
	Dim debugCount
	debugCount = 0

' Setup ADO objects.
	Set adoCommand = CreateObject("ADODB.Command")
	Set adoConnection = CreateObject("ADODB.Connection")
	adoConnection.Provider = "ADsDSOObject"
	adoConnection.Open "Active Directory Provider"
	adoCommand.ActiveConnection = adoConnection

'	dim CNToCheck
'	CNTOCheck = CNTOCheck = "OU=DE,DC=myDom,DC=myTLD"  ' which users should be considered
'	CNTOCheck = "OU=DE," ' which users should be considered

' 	Search entire Active Directory domain.

	Set objRootDSE = GetObject("LDAP://RootDSE")

	strDNSDomain = objRootDSE.Get("defaultNamingContext")
	if cntoCheck <> "" then
		strBase = "<LDAP://" & cntoCheck & ">"
	else
		strBase = "<LDAP://" & strDNSDomain  & ">"
	end if
	
	myDebug("searchbase: " &  strbase )
	if DDEEVV = true then  LogFileWrite("searchbase: " &  strbase )
	
	' Filter on user objects.
	strFilter = "(&(objectCategory=person)(objectClass=user))"
	'strFilter = "(&(objectCategory=person)(objectClass=user)(!sAMAccountType=805306370)(!manager=*))" 
 	' Comma delimited list of attribute values to retrieve.
	strAttributes = "sAMAccountName,distinguishedName"

	' Construct the LDAP syntax query.
	strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	adoCommand.CommandText = strQuery
	adoCommand.Properties("Page Size") = 100
	adoCommand.Properties("Timeout") = 30
	adoCommand.Properties("Cache Results") = False

	' Run the query.
	Set adoRecordset = adoCommand.Execute

	dim strsAMAccountName, strDistinguishedName
	' Enumerate the resulting recordset.
	
	dim TableData(150,2)
	dim TableWhere(40,2)
	dim TableI 
	
	Do Until adoRecordset.EOF

		if DDEEVV = true then On Error Goto 0 Else On Error Resume Next
	    ' Retrieve values and display.
	    strsAMAccountName = adoRecordset.Fields("sAMAccountName").Value
	    strdistinguishedName = adoRecordset.Fields("distinguishedName").value

		Set objUser = ADOpen(strDistinguishedName)
		if not isobject(objUser)  then
				myDebug("strDistinguishedName: no object " & strDistinguishedName )
				if DDEEVV = true then  LogFileWrite("strDistinguishedName: no object " & strDistinguishedName )	
				'continue 
		end if 
		
		myDebug("strDistinguishedName: " & strDistinguishedName )
		if DDEEVV = true then  LogFileWrite("strDistinguishedName: " & strDistinguishedName )
		TableI = 0
		
		'TableData (TableI,0) = "[ID]" 					: TableData (TableI,1) = "Autoincrement(1,1)" 	: TableData (TableI,2) = "*"							: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'on error resume next
		'.distinguishedName
		TableData (TableI,0) = "[DistinguishedName]" : TableData (TableI,1) = MyTypeMemo 			: TableData (TableI,2) = clean(strDistinguishedName) 				: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 		
		'.sAMAccountName
		TableData (TableI,0) = "[sAMAccountName]" 	: TableData (TableI,1) = MyTypeMemo 			: TableData (TableI,2) = clean(StrsAMAccountName) 					: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		
		TableData (TableI,0) = "[MobileNr]" 		: TableData (TableI,1) = MyTypeMemo				: TableData (TableI,2) = clean(extract(objuser.info, "MOB"))		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "[MobileDevice]" 	: TableData (TableI,1) = MyTypeMemo 			: TableData (TableI,2) = clean(extract(objuser.info, "MOBDevice"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "[MobileImei]" 		: TableData (TableI,1) = MyTypeMemo 			: TableData (TableI,2) = clean(extract(objuser.info, "MOBIMEI"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "[MobileSim]" 		: TableData (TableI,1) = MyTypeMemo 			: TableData (TableI,2) = clean(extract(objuser.info, "MOBSIM"))		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "[MobileDate]" 		: TableData (TableI,1) = MyTypeMemo 			: TableData (TableI,2) = clean(extract(objuser.info, "MOBDATE"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		
		TableData (TableI,0) = "[BBNr]" 			: TableData (TableI,1) = MyTypeMemo				: TableData (TableI,2) = clean(extract(objuser.info, "BB"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "[BBDevice]" 		: TableData (TableI,1) = MyTypeMemo 			: TableData (TableI,2) = clean(extract(objuser.info, "BBDevice"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "[BBImei]" 			: TableData (TableI,1) = MyTypeMemo 			: TableData (TableI,2) = clean(extract(objuser.info, "BBIMEI"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "[BBSim]" 			: TableData (TableI,1) = MyTypeMemo 			: TableData (TableI,2) = clean(extract(objuser.info, "BBSIM"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableData (TableI,0) = "[BBDate]" 			: TableData (TableI,1) = MyTypeMemo 			: TableData (TableI,2) = clean(extract(objuser.info, "BBDATE"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		
		'(extract(objuser.info, "ATTSerial"), "AT+T_Serial", introw)
		TableData (TableI,0) = "[ATTSerial]" 		: TableData (TableI,1) = MyTypeMemo					: TableData (TableI,2) = clean(extract(objuser.info, "ATTSerial"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'(extract(objuser.info, "ATTExpire"), "AT+T_Expire", introw)
		TableData (TableI,0) = "[ATTExpire]" 		: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extract(objuser.info, "ATTExpire"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		
		'(extract(objuser.info, "ATTDate"), "AT+T_Date", introw)
		TableData (TableI,0) = "[ATTDate]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extract(objuser.info, "ATTDate"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'(extract(objuser.info, "ATTLogin"), "AT+T_Login", introw)
		TableData (TableI,0) = "[ATTLogin]" 		: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extract(objuser.info, "ATTLogin"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'(extract(objuser.info, "ZB0Item"), "ZB0_Item", introw)
		TableData (TableI,0) = "[ZB0Item]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extract(objuser.info, "ZB0Item"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'(extract(objuser.info, "ZB0Date"), "ZB0_Date", introw)
		TableData (TableI,0) = "[ZB0Date]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extract(objuser.info, "ZB0Date"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'(extract(objuser.info, "ZB1Item"), "ZB1_Item", introw)
		TableData (TableI,0) = "[ZB1Item]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extract(objuser.info, "ZB1Item"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'(extract(objuser.info, "ZB1Date"), "ZB1_Date", introw)
		TableData (TableI,0) = "[ZB1Date]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extract(objuser.info, "ZB1Date"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'(extract(objuser.info, "ZB2Item"), "ZB2_Item", introw)
		TableData (TableI,0) = "[ZB2Item]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extract(objuser.info, "ZB2Item"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'(extract(objuser.info, "ZB2Date"), "ZB2_Date", introw)
		TableData (TableI,0) = "[ZB2Date]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extract(objuser.info, "ZB2Date"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'(extract(objuser.info, "ZB3Item"), "ZB3_Item", introw)
		TableData (TableI,0) = "[ZB3Item]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extract(objuser.info, "ZB3Item"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'(extract(objuser.info, "ZB3Date"), "ZB3_Date", introw)
		TableData (TableI,0) = "[ZB3Date]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extract(objuser.info, "ZB3Date"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'(extract(objuser.info, "ZB4Item"), "ZB4_Item", introw)
		TableData (TableI,0) = "[ZB4Item]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extract(objuser.info, "ZB4Item"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'(extract(objuser.info, "ZB4Date"), "ZB4_Date", introw)
		TableData (TableI,0) = "[ZB4Date]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extract(objuser.info, "ZB4Date"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'(extract(objuser.info, "ZB5Item"), "ZB5_Item", introw)
		TableData (TableI,0) = "[ZB5Item]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extract(objuser.info, "ZB5Item"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		'(extract(objuser.info, "ZB5Date"), "ZB5_Date", introw)
		TableData (TableI,0) = "[ZB5Date]" 			: TableData (TableI,1) = MyTypeMemo 				: TableData (TableI,2) = clean(extract(objuser.info, "ZB5Date"))	: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 

		TableData (TableI,0) = "" 						: TableData (TableI,1) = "" 					: TableData (TableI,2) = ""
	
		TableI = 0
		TableWhere (TableI,0) = "[DistinguishedName]" 		: TableWhere (TableI,1) = "text (400)" 	: TableWhere (TableI,2) = clean(StrDistinguishedName) 		: myDebug(TableData (TableI,0) & " " & TableData (TableI,2) ) : TableI = TableI + 1 
		TableWhere (TableI,0) = "" 						: TableWhere (TableI,1) = "" 		: TableWhere (TableI,2) = ""

	
		WScript.sleep EnventoryWaitPerRecord * 1000
		XMLDoTableAr "UserAccessoire", DBTableVersion, TableData, TableWhere, XMLfileObj
		DBDOTableAr DBGetTableName("UserAccessoire"), DBTableVersion, TableData, TableWhere, DBhistoryUnique 
	    ' Move to the next record in the recordset.
	    adoRecordset.MoveNext
		if DDEEVV = true then
			debugCount = debugCount + 1
			myDebug("movenext:" & debugCount)
			if debugcount = 50 then
			   exit do
			end if 
		end if
	Loop

	' Clean up.

	adoRecordset.Close
	adoConnection.Close

	DBClearHistory DBGetTableName("UserAccessoire") , True
	
	if MessageToSend = true then
		on error goto 0
		Call SendMail (SuiteName &"."&SuiteProg & " " & UserNameGet() & "@" & ComputerNameGet() & "- New Software found!" , htmlBody, "")
	end if
	On Error Goto 0
End Sub

Function PwdLastSetGet( ComputerDistName)
	' PwdLastSet.vbs
	' VBScript program to retrieve password information for a user.
	' This includes the date the password was last set, the domain maximum
	' password age policy, and whether the user can change their password.
	'
	' ----------------------------------------------------------------------
	' Copyright (c) 2002 Richard L. Mueller
	' Hilltop Lab web site - http://www.rlmueller.net
	' Version 1.0 - December 5, 2002
	' Version 1.1 - March 7, 2003 - Standardize Hungarian notation.
	' Version 1.2 - April 27, 2003 - Retrieve pwdLastSet from one DC.
	' Version 1.3 - May 9, 2003 - Account for error in IADsLargeInteger
	'                             property methods HighPart and LowPart.
	'
	' You have a royalty-free right to use, modify, reproduce, and
	' distribute this script file in any way you find useful, provided that
	' you agree that the copyright owner above has no warranty, obligations,
	' or liability for such use.
	Dim objUser, strUserDN, objShell, lngBiasKey, lngBias, k
	Dim objRootDSE, strDNSDomain, objDomain, objMaxPwdAge, intMaxPwdAge
	Dim objDate, dtmPwdLastSet, lngFlag, blnPwdExpire, blnExpired
	Dim lngHighAge, lngLowAge
	
	mydebug( "PwdLastSetGet Hard code user Distinguished Name." )
	
	Dim myRes(4)
	
	Const ADS_UF_PASSWD_CANT_CHANGE = &H40
	Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
	
	' Hard code user Distinguished Name.
	strUserDN =  ComputerDistName
	Set objUser = GetObject("LDAP://" & strUserDN)
	
	mydebug( "PwdLastSetGet Obtain local time zone bias from machine registry." )
	
	' Obtain local time zone bias from machine registry.
	Set objShell = CreateObject("Wscript.Shell")
	lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
		& "TimeZoneInformation\ActiveTimeBias")
	If (UCase(TypeName(lngBiasKey)) = "LONG") Then
		lngBias = lngBiasKey
	ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
		lngBias = 0
		For k = 0 To UBound(lngBiasKey)
			lngBias = lngBias + (lngBiasKey(k) * 256^k)
		Next
	End If
	
	mydebug( "PwdLastSetGet " )
	
	' Determine domain maximum password age policy in days.
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDNSDomain = objRootDSE.Get("DefaultNamingContext")
	Set objDomain = GetObject("LDAP://" & strDNSDomain)
	Set objMaxPwdAge = objDomain.MaxPwdAge
	
	mydebug( "PwdLastSetGet Account for bug in IADslargeInteger property methods." )
	
	' Account for bug in IADslargeInteger property methods.
	lngHighAge = objMaxPwdAge.HighPart
	lngLowAge = objMaxPwdAge.LowPart
	If (lngLowAge < 0) Then
		lngHighAge = lngHighAge + 1
	End If
	intMaxPwdAge = -((lngHighAge * 2^32) _
		+ lngLowAge)/(600000000 * 1440)
	
	mydebug( "PwdLastSetGet Retrieve user password information" )
	' Retrieve user password information.
	Set objDate = objUser.PwdLastSet
	dtmPwdLastSet = Integer8Date(objDate, lngBias)
	lngFlag = objUser.Get("userAccountControl")
	blnPwdExpire = True
	If ((lngFlag And ADS_UF_PASSWD_CANT_CHANGE) <> 0) Then
		blnPwdExpire = False
	End If
	If ((lngFlag And ADS_UF_DONT_EXPIRE_PASSWD) <> 0) Then
		blnPwdExpire = False
	End If
	mydebug( "PwdLastSetGet " )
	' Determine if password expired.
	blnExpired = False
	If (blnPwdExpire = True) Then
		If (DateDiff("d", dtmPwdLastSet, Now) > intMaxPwdAge) Then
			blnExpired = True
		End If
	End If

	
	' Display password information.
	'if DDEEVV = true then myDebug "User: " & strUserDN & VbCrLf & "Password last set: " _
	'	& dtmPwdLastSet & VbCrLf & "Maximum password age (days): " _
	'	& intMaxPwdAge & VbCrLf & "Can password expire? " & blnPwdExpire _
	'	& VbCrLf & "Password expired? " & blnExpired
	mydebug( "PwdLastSetGet dtmPwdLastSet " & dtmPwdLastSet  )	
	myRes(PwdLastSetGetPwdLastSet) = dtmPwdLastSet
	mydebug( "PwdLastSetGet  intMaxPwdAge" )
	myRes(PwdLastSetGetMaxPwdAge) = intMaxPwdAge
	mydebug( "PwdLastSetGet  blnPwdExpire" )
	if blnPwdExpire = true then
		myRes(PwdLastSetGetCanExpire) = "canExpire"
		mydebug( "PwdLastSetGet canExpire" )
	else
		myRes(PwdLastSetGetCanExpire) = "canNOTExpire"
		mydebug( "PwdLastSetGet canNOTExpiren" )
	end if 
	mydebug( "PwdLastSetGet  blnExpired" )
	if blnExpired = true then
		myRes(PwdLastSetGetIsExpired) = "isExpired"
		mydebug( "PwdLastSetGet isExpired" )
	else
		myRes(PwdLastSetGetIsExpired) = "NOTExpired"
		mydebug( "PwdLastSetGet NOTExpired" )
	end if
	mydebug( "PwdLastSetGet Display password information done" )
	PwdLastSetGet = myRes
	
	' Clean up.
	Set objUser = Nothing
	Set objShell = Nothing
	Set objRootDSE = Nothing
	Set objDomain = Nothing
	Set objMaxPwdAge = Nothing
	Set objDate = Nothing
	mydebug( "PwdLastSetGet done" )
End Function

Function Integer8Date(ByVal objDate, ByVal lngBias)
    ' Function to convert Integer8 (64-bit) value to a date, adjusted for
    ' local time zone bias.
    Dim lngAdjust, lngDate, lngHigh, lngLow
    lngAdjust = lngBias
    lngHigh = objDate.HighPart
    lngLow = objDate.LowPart
    ' Account for bug in IADslargeInteger property methods.
    If (lngLow < 0) Then
        lngHigh = lngHigh + 1
    End If
    If (lngHigh = 0) And (lngLow = 0) Then
        lngAdjust = 0
    End If
    lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
        + lngLow) / 600000000 - lngAdjust) / 1440
    Integer8Date = CDate(lngDate)
End Function

Public Function extractOU1(field )
	extractOU1 = myextract(field, 1, "OU")
End Function

Public Function extractCN(field )
	extract ComputerDistName = myextract(field, 1, "CN")
End Function

Public Function extractOU2(field)
	extractOU2 = myextract(field, 2, "OU")
End Function

Public Function extractOU3(field)
	extractOU3 = myextract(field, 3, "OU")
End Function

Public Function myextract(field , item , search)
	Dim cstring
	Dim fieldwork
	Dim cstart
	Dim cend
	Dim cendSemi
	Dim cendCR
	Dim cendLF
	dim CendCRLF
	
	Dim mytextlen
	fieldwork = field
	myextract = ""
	search = search & "="
	cstart = InStr(1, fieldwork, search)
	If item = 2 Then
		cstart = InStr(cstart + 1, fieldwork, search)
	End If
	mytextlen = Len(fieldwork) - cstart - Len(search) + 1
	If mytextlen > 0 Then
		cstring = Right(fieldwork, mytextlen)
		If cstart = 0 Then
			myextract = ""
		Else
			cendSemi = InStr(1, cstring, ",")
			cendCR = InStr(1, cstring, VBCR)
			cendLF = InStr(1, cstring, VBLF)
			cendCRLF = InStr(1, cstring, VBCRLF)

			cend = 0
			if CendSemi <> 0 then cend = cendSemi
			if CendCR <> 0 then if CendCR < cend then cend = cendCr
			if CendLF <> 0 then if CendLF < cend then cend = cendLF
			if CendCRLF <> 0 then if CendCRLF < cend then cend = cendcrlf
			
			If (cend <> 0) Then
				cend = cend - 1
			Else
				cend = Len(cstring)
			End If
			cstring = Left(cstring, cend)
			myextract = cstring
		End If
	Else
		myextract = ""
	End If
End Function

Public Function extract(field, what )
	Dim cstring
	Dim fieldwork
	Dim cstart
	Dim cend
	Dim search
	Dim mytextlen
	extract = ""
	fieldwork = UCase(TrimALL(field,1))
	search = UCase(what)
	search = search & "="
	cstart = InStr(1, fieldwork, search)
	mytextlen = Len(fieldwork) - cstart - Len(search) + 1
	If mytextlen > 0 Then
		cstring = Right(fieldwork, mytextlen)
		If cstart = 0 Then
			extract = ""
		Else
			cend = InStr(1, cstring, ";")
			If (cend <> 0) Then
				cend = cend - 1
			Else
				cend = Len(cstring)
			End If
			cstring = Left(cstring, cend)
				
			extract = cstring
		End If
	Else
		extract = ""
	End If
End Function

Dim ADOpenCN
Dim ADOpenObj

Function ADOpen ( DistName)
	Dim strObjOu
	Dim strObj
	If  DistName = ADOpenCn  Then
		Set ADOpen = ADOpenObj
	Else
		ADOpenObj = Null
		strObj = "LDAP://" &  DistName
		Set ADOpen = GetObject(strObj)
		Set ADOpenObj = ADOpen
	End If
End Function

Function UserDisabledGet( DistName)
	Dim obj
	
	Set obj = ADOpen( DistName)
	
	If obj.AccountDisabled = True Then
			UserDisabledGet = "disabled"
	Else
		UserDisabledGet = "ENABLED"
	End If
	If Err.Number <> 0  Then
			Err.Clear
			UserDisabledGet = "*NotFound*"
	End If
	On Error Goto 0
End Function

Public Function GetDefaultNamingContext()
	Dim objroot, strDomain
	GetDefaultNamingContext = ""
	Set objroot = GetObject("LDAP://rootDSE")
	strDomain = objroot.Get("DefaultNamingContext")
	GetDefaultNamingContext = strDomain
End Function


Public Function LDAPCheck()
	Dim objroot, strDomain, strOU, strObjOu
	Dim ObjOu
	LDAPCheck = False
	' Verbindung zur Domaene herstellen
	if DDEEVV = true then On Error Goto 0 Else On Error Resume Next
	Set objroot = GetObject("LDAP://rootDSE")
	If Err.Number <> 0 Then
			'wscript.echo WScript.ScriptFullName & "::" & myScriptPath & SuiteName & ".tools.vbs " & Err.Number & " -- " &  Err.Description
			LDAPCheck = False
			Err.Clear
	Else
			LDAPCheck = True
	End If
	if DDEEVV = true then On Error Goto 0 Else On Error Resume Next
	strDomain = objroot.Get("DefaultNamingContext")
	If Err.Number <> 0 Then
			'wscript.echo WScript.ScriptFullName & "::" & myScriptPath & SuiteName & ".tools.vbs " & Err.Number & " -- " &  Err.Description
			LDAPCheck = False
			Err.Clear
	Else
		LDAPCheck = True
	End If
	'strOU = "Users,OU=DE"
	If strOU <> "" Then
		strObjOu = "LDAP://OU=" & strOU & "," & strDomain
	Else
		strObjOu = "LDAP://" & strDomain
	End If
	if DDEEVV = true then On Error Goto 0 Else On Error Resume Next
	Set ObjOu = GetObject(strObjOu)
	ObjOu.Filter = Array("User", "organizationalUnit")
	If Err.Number <> 0 Then
			'wscript.echo WScript.ScriptFullName & "::" & myScriptPath & SuiteName & ".tools.vbs " & Err.Number & " -- " &  Err.Description
			LDAPCheck = False
			Err.Clear
	Else
		LDAPCheck = True
	End If
	On Error Goto 0
End Function

Function logonasstring(objuser)
	Dim objLastLogon
	Dim doubleLastLogonTime
	Dim dtmLastLogon
	Dim dtmLatestLogon
	Dim myDateStr
	Dim myTimeStr
	
	dtmLatestLogon = #1/1/1601#
	'if DDEEVV = true then On Error Goto 0 Else 
	On Error Resume Next
	Set objLastLogon = objUser.Get("lastLogonTimestamp")
	doubleLastLogonTime = objLastLogon.HighPart * (2 ^ 32)
	doubleLastLogonTime = doubleLastLogonTime + objLastLogon.LowPart
	doubleLastLogonTime = doubleLastLogonTime / (60 * 10000000)
	doubleLastLogonTime = doubleLastLogonTime / 1440
	dtmLastLogon = doubleLastLogonTime + #1/1/1601#
	Rem dtmLastLogon = DateAdd("n", intTimeZoneBias, dtmLastLogon)
	Rem dtmLastLogon = DateAdd("n", -intDaylightBias, dtmLastLogon)
	If dtmLastLogon > dtmLatestLogon Then
		dtmLatestLogon = dtmLastLogon
	End If
	If Err.Number <> 0 Then
		logonasstring = "*NotSet*"	
	Else
		myDateStr = Year(dtmLatestLogon) & "-" & Right("00" & Left(Int(Month(dtmLatestLogon)), 2), 2) & "-" & Right("00" & Left(Int(Day(dtmLatestLogon)), 2), 2)
		myTimeStr = FormatDateTime(DBmytime, 4)
		logonasstring = myDateStr & " " & myTimeStr & " GMT"
	End If
	On Error Goto 0
	
End Function

'' SIG '' Begin signature block
'' SIG '' MIID6AYJKoZIhvcNAQcCoIID2TCCA9UCAQExDjAMBggq
'' SIG '' hkiG9w0CBQUAMGYGCisGAQQBgjcCAQSgWDBWMDIGCisG
'' SIG '' AQQBgjcCAR4wJAIBAQQQTvApFpkntU2P5azhDxfrqwIB
'' SIG '' AAIBAAIBAAIBAAIBADAgMAwGCCqGSIb3DQIFBQAEEPJb
'' SIG '' 7d8eEln7tJ8KS/AtZ/ygggISMIICDjCCAXegAwIBAgIQ
'' SIG '' fduYp37PJolB2l4qUoy9tjANBgkqhkiG9w0BAQQFADAV
'' SIG '' MRMwEQYDVQQDEwplLW52ZW50b3J5MB4XDTEwMTIzMTIz
'' SIG '' MDAwMFoXDTE2MTIzMTIzMDAwMFowFTETMBEGA1UEAxMK
'' SIG '' ZS1udmVudG9yeTCBnzANBgkqhkiG9w0BAQEFAAOBjQAw
'' SIG '' gYkCgYEAxoqL8otb0bZl/B6QNeNKa7wgv9FzkgeuH0/K
'' SIG '' Mqta3uf+k/JJF0eRdm/e+R17t2Fy0nn4kkfK/0339ZKA
'' SIG '' j+LrC6N0Z2XzotG2Tf5CR2XYHwGWtXvL1edczqrPEwnJ
'' SIG '' Bep8Fki6p0/CSSFueWSjRmMr3nP5+PNnMWarU/OyVdep
'' SIG '' yDMCAwEAAaNfMF0wEwYDVR0lBAwwCgYIKwYBBQUHAwMw
'' SIG '' RgYDVR0BBD8wPYAQlJeutLm/XtOFAEGETQ1/HKEXMBUx
'' SIG '' EzARBgNVBAMTCmUtbnZlbnRvcnmCEH3bmKd+zyaJQdpe
'' SIG '' KlKMvbYwDQYJKoZIhvcNAQEEBQADgYEAKFw68m9BqK1a
'' SIG '' mJUm2YxwCsT3mWy4nilgTWlC+wj64jouYVSY1Ozhm7L8
'' SIG '' ALBzVvvFCeHMHmvpN4pZdqzAf9CnTcNWPkYBq5Hep2aM
'' SIG '' by6t/JiG9lPhC327WWW5IQV3T+FtK2G1qW9UMGi83PMV
'' SIG '' FhUJeBp5hhxXhWORlcBZg5aiVpgxggFAMIIBPAIBATAp
'' SIG '' MBUxEzARBgNVBAMTCmUtbnZlbnRvcnkCEH3bmKd+zyaJ
'' SIG '' QdpeKlKMvbYwDAYIKoZIhvcNAgUFAKBsMBAGCisGAQQB
'' SIG '' gjcCAQwxAjAAMBkGCSqGSIb3DQEJAzEMBgorBgEEAYI3
'' SIG '' AgEEMBwGCisGAQQBgjcCAQsxDjAMBgorBgEEAYI3AgEV
'' SIG '' MB8GCSqGSIb3DQEJBDESBBCdmAFNofTtZT4v/m6Yyeng
'' SIG '' MA0GCSqGSIb3DQEBAQUABIGAQHbeGP1H/E++Fgmn2YdN
'' SIG '' 35kMnC99vndnl508lwYBiYbloG2CdVS1D6Ju2pqmoux5
'' SIG '' MZYnI5xDUiPEqQe9pWI24nP1EpZyzzjYKQ4nFJX1pawz
'' SIG '' 0kySlfRohKnQA3TWnsnIh4ZSjCcgxxP/qfYp4/v+SYWQ
'' SIG '' o2or/935OATboz8rzuk=
'' SIG '' End signature block
